Duplicate Rows

In the movie_metadata dataset, we can derive that their are 45 duplicated rows which needs to be removed and kept the unique ones.

# find duplicated rows
sum(duplicated(movie_metadata))

## [1] 45

# Remove duplicated rows
movie_metadata <- movie_metadata[!duplicated(movie_metadata), ]

Missing Values

Let’s have a look at the number of NA values in our dataset:

# Find NA values
colSums(sapply(movie_metadata, is.na))

##                     color             director_name 
##                         0                         0 
##    num_critic_for_reviews                  duration 
##                        49                        15 
##   director_facebook_likes    actor_3_facebook_likes 
##                       103                        23 
##              actor_2_name    actor_1_facebook_likes 
##                         0                         7 
##                     gross                    genres 
##                       874                         0 
##              actor_1_name               movie_title 
##                         0                         0 
##           num_voted_users cast_total_facebook_likes 
##                         0                         0 
##              actor_3_name      facenumber_in_poster 
##                         0                        13 
##             plot_keywords           movie_imdb_link 
##                         0                         0 
##      num_user_for_reviews                  language 
##                        21                         0 
##                   country            content_rating 
##                         0                         0 
##                    budget                title_year 
##                       487                       107 
##    actor_2_facebook_likes                imdb_score 
##                        13                         0 
##              aspect_ratio      movie_facebook_likes 
##                       327                         0

To help visualise this, have a look at the following heatmap of the missing values:

# Visualise Missing Values
missing.values <- aggr(movie_metadata, sortVars = T, prop = T, sortCombs = T, cex.lab = 1.5, cex.axis = .6, cex.numbers = 5, combined = F, gap = -.2)

## 
##  Variables sorted by number of missings: 
##                   Variable       Count
##                      gross 0.174869948
##                     budget 0.097438976
##               aspect_ratio 0.065426170
##                 title_year 0.021408563
##    director_facebook_likes 0.020608243
##     num_critic_for_reviews 0.009803922
##     actor_3_facebook_likes 0.004601841
##       num_user_for_reviews 0.004201681
##                   duration 0.003001200
##       facenumber_in_poster 0.002601040
##     actor_2_facebook_likes 0.002601040
##     actor_1_facebook_likes 0.001400560
##                      color 0.000000000
##              director_name 0.000000000
##               actor_2_name 0.000000000
##                     genres 0.000000000
##               actor_1_name 0.000000000
##                movie_title 0.000000000
##            num_voted_users 0.000000000
##  cast_total_facebook_likes 0.000000000
##               actor_3_name 0.000000000
##              plot_keywords 0.000000000
##            movie_imdb_link 0.000000000
##                   language 0.000000000
##                    country 0.000000000
##             content_rating 0.000000000
##                 imdb_score 0.000000000
##       movie_facebook_likes 0.000000000

Gross and Budget

Since gross and budget have too many missing values (874 and 488), and we want to keep these two variables for the following analysis, we can only delete rows with null values for gross and budget because imputation will not do a good job here.

# Find NA values for gross and budget
movie_metadata <- movie_metadata[!is.na(movie_metadata$gross), ]
movie_metadata <- movie_metadata[!is.na(movie_metadata$budget), ]
dim(movie_metadata)

## [1] 3857   28

The difference in observations have decreased by 4998 - 3857 = 1141 which is luckily only 22.8% of the previous total observations.

Content Rating

The dataset contains a vast range of content rating, which can be seen below:

# Look at all the different types of content ratings
table(movie_metadata$content_rating)

## 
##            Approved         G        GP         M     NC-17 Not Rated 
##        51        17        91         1         2         6        42 
##    Passed        PG     PG-13         R   Unrated         X 
##         3       573      1314      1723        24        10

We find that M = GP = PG, X = NC-17, so let’s replace M and GP with PG, and X with NC-17, because these are (apparently) what we use today.

# Renaming content ratings 
movie_metadata$content_rating[movie_metadata$content_rating == 'M']   <- 'PG' 
movie_metadata$content_rating[movie_metadata$content_rating == 'GP']  <- 'PG' 
movie_metadata$content_rating[movie_metadata$content_rating == 'X']   <- 'NC-17' # No one under 17

We want to replace Approved, Not Rated, Passed, Unrated with the most common rating R.

movie_metadata$content_rating[movie_metadata$content_rating == 'Approved']  <- 'R' 
movie_metadata$content_rating[movie_metadata$content_rating == 'Not Rated'] <- 'R' 
movie_metadata$content_rating[movie_metadata$content_rating == 'Passed']    <- 'R' 
movie_metadata$content_rating[movie_metadata$content_rating == 'Unrated']   <- 'R' 
movie_metadata$content_rating <- factor(movie_metadata$content_rating)
table(movie_metadata$content_rating)

## 
##           G NC-17    PG PG-13     R 
##    51    91    16   576  1314  1809

Blank spaces should be taken as missing value. Since these missing values cannot be replaced with reasonable data, we delete these rows.

# Remove rows with blank content ratings
movie_metadata <- movie_metadata[!(movie_metadata$content_rating %in% ""),]

Delete (Some) Rows

Let’s now have a look at how many complete cases we have.

colSums(sapply(movie_metadata, is.na))

##                     color             director_name 
##                         0                         0 
##    num_critic_for_reviews                  duration 
##                         1                         0 
##   director_facebook_likes    actor_3_facebook_likes 
##                         0                         6 
##              actor_2_name    actor_1_facebook_likes 
##                         0                         1 
##                     gross                    genres 
##                         0                         0 
##              actor_1_name               movie_title 
##                         0                         0 
##           num_voted_users cast_total_facebook_likes 
##                         0                         0 
##              actor_3_name      facenumber_in_poster 
##                         0                         6 
##             plot_keywords           movie_imdb_link 
##                         0                         0 
##      num_user_for_reviews                  language 
##                         0                         0 
##                   country            content_rating 
##                         0                         0 
##                    budget                title_year 
##                         0                         0 
##    actor_2_facebook_likes                imdb_score 
##                         2                         0 
##              aspect_ratio      movie_facebook_likes 
##                        55                         0

We remove aspect_ratio because 1. it has a lot of missing values and 2. we will not be looking into the impact that it has on other data (we assume that it doesn’t).

# Remove aspect_ratio column
movie_metadata <- subset(movie_metadata, select = -c(aspect_ratio))

Add a Column

# add profit and return of investment column
movie_metadata <- movie_metadata %>% 
  mutate(profit = gross - budget,
         return_on_investment_perc = (profit/budget)*100)

Remove (Some) Columns

# Get colour display types of movies
table(movie_metadata$color)

## 
##                   Black and White            Color 
##                2              124             3680

# remove colour column
movie_metadata <- subset(movie_metadata, select = -c(color))

# Look at different languages
table(movie_metadata$language)

## 
##            Aboriginal     Arabic    Aramaic    Bosnian  Cantonese 
##          2          2          1          1          1          7 
##      Czech     Danish       Dari      Dutch    English   Filipino 
##          1          3          2          3       3644          1 
##     French     German     Hebrew      Hindi  Hungarian Indonesian 
##         34         11          2          5          1          2 
##    Italian   Japanese     Kazakh     Korean   Mandarin       Maya 
##          7         10          1          5         14          1 
##  Mongolian       None  Norwegian    Persian Portuguese   Romanian 
##          1          1          4          3          5          1 
##    Russian    Spanish       Thai Vietnamese       Zulu 
##          1         24          3          1          1

# Look at different countries
table(movie_metadata$country)

## 
##    Afghanistan      Argentina          Aruba      Australia        Belgium 
##              1              3              1             40              1 
##         Brazil         Canada          Chile          China       Colombia 
##              5             63              1             13              1 
## Czech Republic        Denmark        Finland         France        Georgia 
##              3              9              1            103              1 
##        Germany         Greece      Hong Kong        Hungary        Iceland 
##             79              1             13              2              1 
##          India      Indonesia           Iran        Ireland         Israel 
##              5              1              4              7              2 
##          Italy          Japan         Mexico    Netherlands       New Line 
##             11             15             10              3              1 
##    New Zealand         Norway  Official site           Peru    Philippines 
##             11              4              1              1              1 
##         Poland        Romania         Russia   South Africa    South Korea 
##              1              2              3              3              8 
##          Spain         Taiwan       Thailand             UK            USA 
##             22              2              4            316           3025 
##   West Germany 
##              1

# Grouping countries
levels(movie_metadata$country) <- c(levels(movie_metadata$country), "Others")
movie_metadata$country[(movie_metadata$country != 'USA')&(movie_metadata$country != 'UK')] <- 'Others' 
movie_metadata$country <- factor(movie_metadata$country)
table(movie_metadata$country)

## 
## Others     UK    USA 
##    465    316   3025

Basic Analysis

Let’s first have a look at the number of movies that are produced over the years.

# Plotting the number of movies released
ggplot(movie_metadata, aes(title_year)) +
  geom_bar() +
  labs(x = "Year movie was released", y = "Movie Count", title = "Number of Movies Released Per Year (1916 - 2016)") +
  theme(plot.title = element_text(hjust = 0.5)) +
  geom_vline(xintercept=c(1980), linetype="dotted") +
  ggplot2::annotate("text", label = "Year = 1980",x = 1979, y = 50, size = 3, colour = "blue", angle=90)

From the graph, we see there aren’t many records of movies released before 1980. It’s better to remove those records because they might not be representative of the data.

movie_metadata <- movie_metadata[movie_metadata$title_year >= 1980,]

Let’s have a look at the movie counts now:

# Plotting the number of movies released since 1980
ggplot(movie_metadata, aes(title_year)) +
  geom_bar() +
  labs(x = "Year movie was released", y = "Movie Count", title = "Number of Movies Released Per Year (1980 - 2016)") +
  theme(plot.title = element_text(hjust = 0.5))

The graph above illustrate the number of movies released for the period 1980 - 2016. As we can see, from the 1980’s a quick and exponential rise of movies released occurred.

Movie Genre Analysis

Now we can delve into more specific things regarding movies, like genres.

genre = movie_metadata['genres']

# Make genre a dataframe
genre = data.frame(table(genre))

# Order genres based on frequency
genre = genre[order(genre$Freq,decreasing=TRUE),]

# Top 20 genres with the most movies
ggplot(genre[1:20,], aes(x=reorder(factor(genre), Freq), y=Freq, alpha=Freq)) + 
  geom_bar(stat = "identity", fill="maroon") + 
  geom_text(aes(label=Freq),hjust=1.2, size=3.5)+
  xlab("Genre") + 
  ylab("Number of Movies") + 
  ggtitle("Top 20 Genres with the most movies") + 
  coord_flip()

head(movie_metadata$genres)

## [1] "Action|Adventure|Fantasy|Sci-Fi" "Action|Adventure|Fantasy"       
## [3] "Action|Adventure|Thriller"       "Action|Thriller"                
## [5] "Action|Adventure|Sci-Fi"         "Action|Adventure|Romance"

# Split on "|"
genres_split <- str_split(movie_metadata$genres, pattern="[|]", n=2)

# Create Matrix
genres_matrix <- do.call(rbind, strsplit(movie_metadata$genres, '[|]'))

# Dataframe of genres
genres_df <- as.data.frame(genres_matrix)

# Collapse all genres into one column
genres_one_col <- gather(genres_df) %>% 
  select(value)

# Top 30
top30 <- genres_one_col %>%
  group_by(value) %>% 
  tally() %>% 
  filter(n >= 30)

# Plot frequency of first column
top30 %>% 
  ggplot(aes(x=reorder(factor(value), n), y=n, alpha=n)) +
  geom_bar(stat="identity", fill="maroon") +
  geom_text(aes(label=n),hjust=1.2, size=3.5) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  xlab("Genre") +
  ylab("Frequency") +
  ggtitle("Movie Genre Frequency") +
  coord_flip()

# Remove old genre column
movie_metadata <- subset(movie_metadata, select = -c(genres))

# Take first column of genres_df and add it to MAIN df
movie_metadata$genre <- genres_df$V1

# Plotting the movie genres produced
movie_metadata %>%
 group_by(title_year, genre) %>%
 summarise(count = n()) %>%
 ggplot(aes(title_year, as.factor(genre))) +
 geom_tile(aes(fill=count),colour="white") +
 scale_fill_gradient(low="light blue",high = "dark blue") +
 xlab("Year of Movie") +
 ylab("Genre of Movie") +
 ggtitle("Heat Map of Movie Genres Produced Over the Years") +
  theme(panel.background = element_blank())

# Add column for total facebook likes
movie_metadata$total_facebook_likes <- movie_metadata$director_facebook_likes + 
  movie_metadata$actor_3_facebook_likes + movie_metadata$actor_1_facebook_likes +
  movie_metadata$cast_total_facebook_likes + movie_metadata$actor_2_facebook_likes + 
  movie_metadata$movie_facebook_likes

# creating a data frame containing avg score, avg votes and avg fb likes
score_votes_likes <- movie_metadata %>% 
  group_by(genre) %>%
  summarise(count = n(),
            avg_score = round(mean(imdb_score), 1),
            avg_votes = mean(num_voted_users),
            avg_facebook_likes = mean(total_facebook_likes),
            avg_reviews = mean(num_user_for_reviews)) %>%
  filter(count > 10)

# arranging data frame by average score
arr_score <- arrange(score_votes_likes, desc(avg_facebook_likes))

# Show data frame
as.data.frame(score_votes_likes)

##          genre count avg_score avg_votes avg_facebook_likes avg_reviews
## 1       Action   937       6.3 145049.12          38762.692    462.1942
## 2    Adventure   356       6.5 133549.07          40494.340    355.0365
## 3    Animation    43       6.7  83318.51          30471.674    202.0698
## 4    Biography   200       7.1 100233.72          41000.900    260.4650
## 5       Comedy   997       6.1  64763.60          23896.765    197.9388
## 6        Crime   247       6.9 130843.95          33857.397    362.5789
## 7  Documentary    32       6.8  16159.19           5623.312    126.3750
## 8        Drama   667       6.8  85462.68          31889.940    319.7301
## 9      Fantasy    37       6.3  87311.14          25452.270    374.7027
## 10      Horror   152       5.7  66091.12          21356.158    406.8750
## 11     Mystery    24       6.6 180824.04          35571.625    570.2500

Popularity Analysis

# Plotting the IMDB ratings vs movie count
ggplot(movie_metadata, aes(imdb_score)) +
  geom_histogram(bins = 50) +
  geom_vline(xintercept = mean(movie_metadata$imdb_score,na.rm = TRUE),colour = "blue") +
  ylab("Movie Count") +
  xlab("IMDB Rating") +
  scale_x_continuous(limits = c(0, 10)) +
  ggtitle("IMDB Ratings for Movies") +
  ggplot2::annotate("text", label = "Mean IMDB rating",x = 6.2, y = 50, size = 3, colour = "yellow",angle=90)

#Creating the required subset of data 
movies_pop <- movie_metadata %>%
 select(title_year, movie_facebook_likes) %>%
 filter(title_year > 1980) %>%
 group_by(title_year) %>%
 summarise(avg = mean(movie_facebook_likes)) 

#Generating the popularity vs time plot
 ggplot(movies_pop, aes(x = title_year, y = avg)) +
   geom_point() +
   geom_smooth() + 
   geom_vline(xintercept = c(2004),colour = c("blue")) +
   ylab("Average Facebook Likes") +
   xlab("Years Movie Was Produced") +
   ggplot2::annotate("text", label = "Facebook",x = 2003.5, y = 10000, size = 3, colour = "blue",angle=90)

# Plotting the Facebook Likes VS IMDB Score
movie_metadata %>% 
  group_by(content_rating) %>% 
  summarise(avg_fb_likes = mean(movie_facebook_likes), avg_imdb_score = mean(imdb_score), num=n()) %>% 
  ggplot() +
    geom_point(aes(x=avg_fb_likes, y=avg_imdb_score, color=content_rating, size=num), stat="identity") + 
  scale_y_continuous(limits = c(0, 10)) +
  xlab("Average Facebook Likes") +
  ylab("Average imdb score")

#Plotting Facebook likes against IMDB score
ggplot(data = movie_metadata, aes(x = imdb_score, y = movie_facebook_likes)) +
  scale_x_continuous(limits = c(0, 10)) +
  geom_smooth()

# Displaying the avg_imdb score of directors
movie_metadata %>%
  group_by(director_name) %>%
  summarise(avg_imdb = mean(imdb_score)) %>%
  arrange(desc(avg_imdb)) %>%
  top_n(20, avg_imdb) %>%
  formattable(list(avg_imdb = color_bar("orange")), align = 'l')

#Performing operations on Movies Vote Count over the years
 movies_vote1 <- movie_metadata %>%
  select(title_year, num_voted_users) %>%
  group_by(title_year) %>%
  summarise(count = sum(num_voted_users)) 

 ggplot(movies_vote1, aes(x = title_year, y = count/1000)) +
   geom_bar( stat = "identity") +
   geom_vline(xintercept = c(1990,2004),colour = c("orange","blue")) +
   ylab("Vote count (in thousands)") +
   xlab("Years") +
   ggplot2::annotate("text", label = "Facebook",x = 2003, y = 21000, size = 3, colour = "blue",angle=90) + 
   ggplot2::annotate("text", label = "IMDB",x = 1989, y = 21000, size = 3, colour = "orange",angle=90)

# breaking num_users_voted into 4 buckets 
movie_metadata$vote_bucket <- cut(movie_metadata$num_voted_users, 
                         c(0, 50000, 100000, 300000, 500000))

# plotting a boxplot for votes vs imdb_score  
bp <- na.omit(movie_metadata) %>% 
  ggplot(aes(x = vote_bucket, y = imdb_score)) +
  geom_boxplot(aes(fill = vote_bucket), alpha = 0.7,
               show.legend = F) +
  stat_summary(fun.y = mean, geom = "point",
               shape = 23) +
  coord_flip() +
  xlab("User Votes") +
  ylab("IMDB Score") +
  ggtitle("Box plot for User Votes vs IMDB Score") +
  theme_minimal() +
  theme(plot.title = element_text(size = 14, 
                                  color = "darkgrey",
                                  family = "Times"))
ggplotly(bp) %>%
  layout(margin = m, 
        xaxis = a, 
        yaxis = a,
        legend = list(orientation = "h", size = 4,
                       bgcolor = "#E2E2E2",
                       bordercolor = "darkgrey",
                       borderwidth = 1,
                       x = 0,
                       y = -0.3)) 

# scatter plot for user votes vs imdb score
scatter_plot(movie_metadata$num_voted_users, movie_metadata$imdb_score, 
     "User Votes",
     "IMDB Score",
     "Scatter plot for User Votes vs IMDB Score",
     "User Votes:",
     "<br>IMDB Score:",
     "<br>Title:",
     alpha = 0.3)

# creating a data frame for average score, avg votes and, avg user reviews
# by title year
scat_year_score <- movie_metadata %>%
  group_by(title_year) %>%
  summarise(count = n(),
            IMDB_Score = round(mean(imdb_score),1),
            avg_votes = mean(num_voted_users),
            avg_user_review = round(mean(num_user_for_reviews)))

# plotting line graph for Avg score by title year 
lp1 <- line_graph(scat_year_score, 
                  scat_year_score$IMDB_Score, 
                  "Average Score")

# plotting line graph for Avg votes by title year
lp2 <- line_graph(scat_year_score, 
                  scat_year_score$avg_votes, 
                  "Average Votes")

# plotting line graph for Avg reviews by title year
lp3 <- line_graph(scat_year_score,
                  scat_year_score$avg_user_review,
                  "Average User Review") 


subplot(lp1, lp2, lp3, nrows = 3, heights = c(0.33, 0.33, 0.33))

Profit | Gross | Return of Interest

# Plotting movie budget and gross
budget <- movie_metadata %>%
  select(movie_title, budget) %>%
  arrange(desc(budget)) %>%
  head(15)

x <- ggplot(budget, aes(x = reorder(movie_title, -desc(budget)), y = budget/1000000)) +
  geom_bar( stat = "identity")+ 
  theme(axis.text.x=element_text(hjust=1))+
  ggtitle("Movie Budgets")+
  xlab("")+
  ylab("Budget (in Millions)") + 
  coord_flip()

rev <- movie_metadata %>%
  select(movie_title, gross) %>%
  arrange(desc(gross)) %>%
  head(15)

y <- ggplot(rev, aes(x = (reorder(movie_title, -desc(gross))), y = gross/1000000)) +
  geom_bar( stat = "identity")+ 
  theme(axis.text.x=element_text(hjust=1))+
  ggtitle("Movie Gross")+
  xlab("")+
  ylab("Gross (in Millions)") + 
  coord_flip() 

ggarrange(x, y,
          labels = c("A", "B"),
          ncol = 1, nrow = 2)

In the above graph, it is evident that the movies with with higher budgets do not essentially mean that they will equate to a high gross profit.

Most Successful Directors based on Profit

#Top 20 most successful directors
movie_metadata %>%
        group_by(director_name) %>%
  mutate(profit = gross - budget)%>%
select(director_name, budget, gross, profit) %>%
na.omit() %>% 
summarise(films = n(), budget = sum(as.numeric(budget)), gross = sum(as.numeric(gross)), profit = sum(as.numeric(profit))) %>%
mutate(avg_per_film = profit/films) %>%
arrange(desc(avg_per_film)) %>% 
top_n(20, avg_per_film) %>%
ggplot( aes(x = films, y = avg_per_film/1000000)) + 
geom_point(size = 1, color = "blue") + 
geom_text_repel(aes(label = director_name), size = 3, color = "blue") + 
xlab("Number of Films") + ylab("Avg Profit $millions") + 
ggtitle("Most Successful Directors")

Looking at the most succesful directors, one can determine that the most successful director produced only one movie (Tim Miller) or creating an array of succesful films with large budgets, such as James Cameron.

Top 20 movies based on its Profit

#Top 20 movies based on its Profit
movie_metadata %>% 
  filter(title_year %in% c(2000:2016)) %>%
  mutate(profit = gross - budget,
         return_on_investment_perc = (profit/budget)*100) %>%
  arrange(desc(profit)) %>% 
  top_n(20, profit) %>%
  ggplot(aes(x=budget/1000000, y=profit/1000000)) + 
  geom_point(size = 2) + 
  geom_smooth(size = 1) + 
  geom_text_repel(aes(label = movie_title), size = 3) + 
  xlab("Budget $million") + 
  ylab("Profit $million") + 
  ggtitle("20 Most Profitable Movies")

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

When assessing the top 20 movies based on profit, Avatar has the highest profit margin, regioning in a similar area to director James cameron.

#Top genres based on its Profit
movie_metadata %>% 
  filter(title_year %in% c(2000:2016)) %>%
  mutate(profit = gross - budget,
         return_on_investment_perc = (profit/budget)*100) %>%
  group_by(genre)%>%
  na.omit() %>% 
  summarise(av_profit = mean(profit), av_budget = mean(budget)) %>%
  arrange(desc(av_profit)) %>% 
  ggplot(aes(x=av_budget/10000, y=av_profit/10000)) + 
  geom_jitter(size = 2) + 
  geom_smooth(size = 1) + 
  geom_text_repel(aes(label = genre), size = 3) + 
  xlab("Budget $million") + 
  ylab("Profit $million") + 
  ggtitle("Average Return for each Genre")

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

As we can see from the above graph, even though comedy and drama are the most popular to be produced, they, overall, are not profitable. The budgets from western and thriller movies are far smaller than that of other genres.

Top 20 movies based on its Return on Investment

#Top 20 movies based on its Return on Investment
movie_metadata %>% 
  filter(budget >100000) %>%
  mutate(profit = gross - budget,
         return_on_investment_perc = (profit/budget)*100) %>%
  arrange(desc(profit)) %>% 
  top_n(20, profit) %>%
  ggplot(aes(x=budget/1000000, y=return_on_investment_perc)) + 
  geom_point(size = 2) + 
  geom_smooth(size = 1) + 
  geom_text_repel(aes(label = movie_title), size = 3) + 
  xlab("Budget $million") + 
  ylab("Percent Return on Investment") + 
  ggtitle("20 Most Profitable Movies based on its Return on Investment")

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Sucessful directors such as George Lucas also have profitable movies.

Commercial success Vs Critical acclaim

# Plotting of the commercial success vs critical accliam
movie_metadata %>%
  top_n(15, profit) %>%
  ggplot(aes(x = imdb_score, y = gross/10^6, size = profit/10^6, color = content_rating)) + 
  geom_point() + 
  geom_hline(aes(yintercept = 600)) + 
  geom_vline(aes(xintercept = 7.75)) + 
  geom_text_repel(aes(label = movie_title), size = 4) +
  xlab("Imdb score") + 
  ylab("Gross money earned in million dollars") + 
  ggtitle("Commercial success Vs Critical acclaim") +
  ggplot2::annotate("text", x = 8.5, y = 700, label = "High ratings \n & High gross") +
  theme(plot.title = element_text(hjust = 0.5))

In the above graph we can compare content rating to the content rating inference as well as the higher grossing films with sucessful directors.

# Plotting the 20 most popular keywords
movie_metadata %>%
  filter(imdb_score >6 ) %>% #Filter to show the graph only for vote_average values greater than 6
  na.omit() %>% 
  ggplot(aes(x = gross/1000000, y = content_rating), height=0) + 
  geom_jitter(alpha = 0.5, col = "darkgreen") + 
  theme(axis.text.x=element_text(angle = 90, hjust = 1))+
  ggtitle("Gross vs Content Rating") +
  xlab("Gross (millions)") +
  ylab("Rating") +
  geom_smooth() +
  coord_flip()

Correlation Heatmap

# Plotting the heatmap
ggcorr(movie_metadata, label = TRUE, label_round = 2, label_size = 2.8, size = 2, hjust = .85) +
  ggtitle("Correlation Heatmap") +
  theme(plot.title = element_text(hjust = 0.5))

## Warning in ggcorr(movie_metadata, label = TRUE, label_round = 2, label_size
## = 2.8, : data in column(s) 'director_name', 'actor_2_name', 'actor_1_name',
## 'movie_title', 'actor_3_name', 'plot_keywords', 'movie_imdb_link',
## 'language', 'country', 'content_rating', 'genre', 'vote_bucket' are not
## numeric and were ignored

Based on the heatmap, we can see some high correlations (greater than 0.7) between predictors.

According to the highest correlation value 0.95, we find actor_1_facebook_likes is highly correlated with the cast_total_facebook_likes, and both actor2 and actor3 are also somehow correlated to the total. So we want to modify them into two variables: actor_1_facebook_likes and other_actors_facebook_likes.

There are high correlations among num_voted_users, num_user_for_reviews and num_critic_for_reviews.

Exploration into Movie Plot Keywords

Keywords from movie plot lines are given in a single column, split by a “|”. The following code will seperate these words into seperate columns.

#Constructing Top 20
keywords_split <- str_split(IMDB$plot_keywords, pattern="[|]", n=5)

keywords_matrix <- do.call(rbind, strsplit(as.character(IMDB$plot_keywords), "[|]"))

keywords_df <- as.data.frame(keywords_matrix)

names(keywords_df) <- c("one", "two", "three", "four", "five")

keywords_one_col <- gather(keywords_df) %>% 
  select(value)

keywords_one_col_freq <- keywords_one_col %>%
  group_by(value) %>%
  tally()

top_20 <- keywords_one_col_freq %>%
  select(value, n) %>%
  top_n(20)

## Selecting by n

movies_with_keywords <- data.frame()
IMDB_keyword_movie <- data.frame()

keywords_one_col %>%
  group_by(value) %>% 
  tally() %>% 
  filter(n > 30) %>% 
  ggplot() +
  geom_bar(aes(x = value, y=n), stat="identity") +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  xlab("Keyword") +
  ylab("Frequency") +
  ggtitle("Frequency of common keywords")

Above we can see the most popular keywords describing the films in the dataset.

The following code checks to see which movies contain common keywords.

#Placing Top 20 Words Against Movie Success

IMDB_true_false <- IMDB 
for (keyword in top_20$value) {
  IMDB_true_false <- cbind(IMDB_true_false, ifelse(str_detect(IMDB$plot_keywords, keyword), "TRUE", "FALSE"))
}

for (i in 1:20) {
  reference <- 27
  names(IMDB_true_false)[reference + i] <- top_20$value[i]  
}

does_contain_common_key <- data.frame()
for (keyword in top_20$value) {
  does_contain_common_key <- rbind(does_contain_common_key, IMDB_true_false %>%
                            filter(get(keyword) == TRUE) %>% select(movie_title, gross, imdb_score, movie_facebook_likes, plot_keywords)) %>%
    distinct(movie_title, .keep_all = T)
}

does_not_contain_common_key <- data.frame()
for (keyword in top_20$value) {
  does_not_contain_common_key <- rbind(does_not_contain_common_key, IMDB_true_false %>%
                            filter(get(keyword) == FALSE) %>% select(movie_title, gross, imdb_score, movie_facebook_likes, plot_keywords)) %>%
    distinct(movie_title, .keep_all = T)
}

head(does_contain_common_key %>% select(movie_title, plot_keywords) %>% sample_n(2)) 

##                movie_title                                 plot_keywords
## 1                The Doors death|paris france|rock band|singer|the doors
## 2 For a Good Time, Call...           friend|friendship|gay|phone sex|sex

Here are two movies that contain at least one common plot keyword.

head(does_not_contain_common_key %>% select(movie_title, plot_keywords) %>% sample_n(2), 2) 

##              movie_title
## 1 The Mothman Prophecies
## 2     The Girl Next Door
##                                                                  plot_keywords
## 1 car accident|death of wife|mothman|point pleasant west virginia|urban legend
## 2  forced to strip|male rear nudity|porn actress|scantily clad female|teenager

Here are two movies that do not contain any of the common plot key words.

does_contain_common_key <- does_contain_common_key %>%
  mutate(tri = "Top 20 Word")

does_not_contain_common_key <- does_not_contain_common_key %>%
  mutate(tri = "NOT Top 20 Word")

all_movies_keywords_indicated <- full_join(does_not_contain_common_key, does_contain_common_key, by = c("movie_title", "gross", "imdb_score", "movie_facebook_likes", "plot_keywords"))

all_movies_keywords_indicated <- all_movies_keywords_indicated %>%
  mutate(type = coalesce(tri.y, tri.x)) %>%
  select(movie_title, gross, imdb_score, movie_facebook_likes, plot_keywords, type)

all_movies_keywords_indicated <-  all_movies_keywords_indicated %>%
  group_by(type) %>%
  na.omit() %>%
  mutate(avg_gross = mean(gross))

options(scipen = 999)

summarise(all_movies_keywords_indicated, avg_gross = mean(gross)) %>%
  ggplot() +
  geom_bar(aes(x = type, y=avg_gross, fill=type), stat="identity", position="stack") +
  theme(axis.text.x = element_blank()) +
  xlab("Type of movie") +
  ylab("Average Gross")

This graph is comparing the average gross of a movie that contains at least one keyword from the list of top 20 most common plot keyword and movies that contain none of these popular keywords.

The average gross for movies that do not contain one of the top 20 most common keywords appear to be higher.

Sentiment pre-processing

The split keywords are needed in order to perform sentiment.

keywords_from_split <- data.frame(lapply(keywords_split, "length<-", max(lengths(keywords_split))))

#All unique years
all_years <- keywords_from_split %>% select(Year)
all_years <- distinct(all_years)
all_years <- na.omit(all_years)
all_years <- all_years %>%
  filter(Year != "NA")

Calculating Sentiment

Below is where the sentiment of keywords is calculated. The sentiment function used comes from the syuzhet package and it can detect the presence of eight different emotions, namely “anger”, “anticipation”, “disgust”, “fear”, “joy”, “sadness”, “surprise” and, “trust”. It is also able to calculate positive and negative valence.

#Function for sentiment per year
yearly_sentiment <- function(year, df) {
  amount <- nrow(df %>%
    select(Year) %>%
    filter(Year == year))
  df <- df %>%
    filter(Year == year)
  sentiments <- get_nrc_sentiment(as.character(df[4]))
  for (i in 1:length(sentiments)) {
    sentiments[i] <- sentiments[i]/amount
  }
  year_sentiment <- cbind(year, sentiments)
  return (year_sentiment)
}

sentiments <- data.frame()

#For-loop to capture all years
for (i in all_years$Year) {
  sentiments <- rbind(sentiments,yearly_sentiment(i, keywords_from_split))
}

#Making years integers
sentiments$year <- strtoi(sentiments$year)

#Sort by year
sentiments_emotions <- sentiments[with(sentiments, order(year)), ] %>% 
  filter(year >= 1980) %>% 
  select(-positive, -negative)

#Heatmap for sentiments
rnames <- sentiments_emotions[,1]
mat_sentiments <- data.matrix(sentiments_emotions[,2:ncol(sentiments_emotions)])
rownames(mat_sentiments) <- rnames
mat_sentiments <- t(mat_sentiments)

df_sentiment <-  as.data.frame(mat_sentiments)
names_emotions <- c("anger", "anticipation", "disgust","fear","joy","sadness","surprise","trust")

sentiments_graph <- cbind(names_emotions, df_sentiment)

#Heatmap
heatmap.2(mat_sentiments, Rowv=NA, Colv=NA, scale="row", col=colorRampPalette(c("white","darkblue")),  margins=c(5,10), trace = "none") 

#Filtering sentiments graph
sentiments_filter <- sentiments %>%
  filter(year >= 1980)

sentiments_filter %>% 
  ggplot(aes(x = year)) +
  geom_line(aes(y = negative, color = 'postive')) +
  geom_line(aes(y = positive, color = 'negative')) + 
  ylab("Sentiment score") +
  xlab("Year") +
  ggtitle("Positive and negative sentiment of keywords across the years")

Constructing the network graph

Actors will be the nodes. Edges exist only if the actors have appeared in a movie together.

##extract the actors
actors <- imdb %>%
  select(actor_1_name, actor_2_name, actor_3_name) 
head(actors, 5)

##      actor_1_name     actor_2_name         actor_3_name
## 1     CCH Pounder Joel David Moore            Wes Studi
## 2     Johnny Depp    Orlando Bloom       Jack Davenport
## 3 Christoph Waltz     Rory Kinnear     Stephanie Sigman
## 4       Tom Hardy   Christian Bale Joseph Gordon-Levitt
## 5     Doug Walker       Rob Walker

actors <- actors %>% 
  filter(actor_1_name != "") %>% 
  filter(actor_2_name != "") %>% 
  filter(actor_3_name != "") 

The nodelist will only contain each actor’s name once.

##make the nodelist
actor_nodes <- actors %>% 
  gather() %>% 
  select(value) %>% 
  distinct(value)

head(actor_nodes, 5)

##             value
## 1     CCH Pounder
## 2     Johnny Depp
## 3 Christoph Waltz
## 4       Tom Hardy
## 5    Daryl Sabara

Because each movie has three top actors given, some column manipulation is needed to format the data into the two “to” and “from” columns required for the edgelist.

##make the edgelist for actor_1 and actor_2
temp_edges_1_2 <- actors %>% 
  select(actor_1_name, actor_2_name) %>% 
  na.omit() %>% 
  dplyr::rename(from = actor_1_name, to = actor_2_name) 

temp_edges_1_2[temp_edges_1_2==""] <- NA
temp_edges_1_2[temp_edges_1_2==" "] <- NA

temp_edges_1_2 <- temp_edges_1_2 %>% 
  na.omit()

head(temp_edges_1_2, 5)

##              from               to
## 1     CCH Pounder Joel David Moore
## 2     Johnny Depp    Orlando Bloom
## 3 Christoph Waltz     Rory Kinnear
## 4       Tom Hardy   Christian Bale
## 5    Daryl Sabara  Samantha Morton

## edgelist for actor_1 and actor_3
temp_edges_1_3 <- actors %>% 
  select(actor_1_name, actor_3_name) %>% 
  na.omit() %>% 
  dplyr::rename(from = actor_1_name) %>% 
  dplyr::rename(to = actor_3_name)

temp_edges_1_3[temp_edges_1_3==""] <- NA
temp_edges_1_3[temp_edges_1_3==" "] <- NA

##remove both values if there is even one NA present, eg Tom Hardy -> NA
temp_edges_1_3 <- temp_edges_1_3%>% 
  na.omit()

head(temp_edges_1_3, 5)

##              from                   to
## 1     CCH Pounder            Wes Studi
## 2     Johnny Depp       Jack Davenport
## 3 Christoph Waltz     Stephanie Sigman
## 4       Tom Hardy Joseph Gordon-Levitt
## 5    Daryl Sabara         Polly Walker

## edgelist for actor_2 and actor_3
temp_edges_2_3 <- actors %>% 
  select(actor_2_name, actor_3_name) %>% 
  na.omit() %>% 
  dplyr::rename(from = actor_2_name) %>% 
  dplyr::rename(to = actor_3_name)

temp_edges_2_3[temp_edges_2_3==""] <- NA
temp_edges_2_3[temp_edges_2_3==" "] <- NA

temp_edges_2_3 <- temp_edges_2_3 %>% 
  na.omit()

head(temp_edges_2_3, 5)

##               from                   to
## 1 Joel David Moore            Wes Studi
## 2    Orlando Bloom       Jack Davenport
## 3     Rory Kinnear     Stephanie Sigman
## 4   Christian Bale Joseph Gordon-Levitt
## 5  Samantha Morton         Polly Walker

##Combine the three sets of edges
actor_edges <- data.frame(from = "", to = "")

actor_edges <- do.call("rbind", list(temp_edges_1_2, temp_edges_1_3, temp_edges_2_3))

temp_edges_1_2 = NULL
temp_edges_1_3 = NULL
temp_edges_2_3 = NULL

head(actor_edges)

##              from               to
## 1     CCH Pounder Joel David Moore
## 2     Johnny Depp    Orlando Bloom
## 3 Christoph Waltz     Rory Kinnear
## 4       Tom Hardy   Christian Bale
## 5    Daryl Sabara  Samantha Morton
## 6    J.K. Simmons     James Franco

##create the graph
actors_in_same_movies <- graph_from_data_frame(actor_edges, directed = F)

Here is a simple network plot of the constructed network.
Here a densely connected core can be seen surrounded by many small nodes that are not connected to the main component.

##write to graphml for Gephi purposes
write.graph(actors_in_same_movies, "../data-out/graphs/actors_in_same_movies.graphml", format=c("graphml"))

##Weight edges instead of duplicate edges
casted_actors <- actor_edges %>% 
  mutate(val = 1) %>% 
  select(from, to, val) %>% 
  cast_sparse(row = from, column = to, value = val)

spread_graph <- graph_from_incidence_matrix(casted_actors)

projected <- bipartite.projection(spread_graph, which = "true") 

Network measures

Eigenvector centrality (also called eigencentrality) is a measure of the influence of a node in a network. It assigns relative scores to all nodes in the network based on the concept that connections to high-scoring nodes contribute more to the score of the node in question than equal connections to low-scoring nodes.

e_values <- readRDS(file="../../g_eigen_values.RDs")

projected <- projected %>% 
  set_vertex_attr(name = "g_e_values", value = e_values$values)

## Warning in vattrs[[name]][index] <- value: number of items to replace is
## not a multiple of replacement length

e_values['values'] %>% 
  as.data.frame() %>% 
  ggplot()+
  geom_density(aes(values)) +
  xlab("Eigen value") 

Eigen values are negatively skewed for global community 1. This means that most nodes are not connected to high scoring nodes.

In a connected graph, the normalized closeness centrality (or closeness) of a node is the average length of the shortest path between the node and all other nodes in the graph. Thus the more central a node is, the closer it is to all other nodes. (stolen from Wiki)

An actor will be well connected if other many actors can be reached in a short number of hops.

close_cent <- projected %>% 
  as_tbl_graph() %>% 
  activate(nodes) %>% 
  igraph::closeness()

var_cc <- mean(close_cent) 

projected <- projected %>% 
  set_vertex_attr(name = "g_close_cent", value = close_cent)

close_cent %>% 
  as.data.frame() %>% 
  dplyr::rename(closeness = '.') %>% 
  ggplot()+
  geom_density(aes(closeness)) +
  xlab("Centrality (Closeness)") + 
  ylab("Frequency")

The closeness distribution is very interesting. There is a high number of nodes with a relatively high and relatively low closeness. This is due to the graph having many small components and one very densely connected large component. The mean value is 0.0000001.

Interpretively, the Boncich power measure corresponds to the notion that the power of a vertex is recursively defined by the sum of the power of its alters. The nature of the recursion involved is then controlled by the power exponent: positive values imply that vertices become more powerful as their alters become more powerful (as occurs in cooperative relations), while negative values imply that vertices become more powerful only as their alters become weaker (as occurs in competitive or antagonistic relations). (stolen from Wiki)

Essentially, the importance of an actor is defined by the importance of alters, or other connected actors.

power_cent <- projected %>% power_centrality(exponent = 0.9)

var_pc <- max(power_cent)

projected <- projected %>% 
  set_vertex_attr(name = "g_power_cent", value = power_cent)

power_cent %>% 
  as.data.frame() %>% 
  dplyr::rename(power = '.') %>% 
  mutate(power = as.numeric(power)) %>% 
  ggplot() +
  geom_density(aes(x=power))

So the distribution of Boncich power is slightly positively skewed meaning that in general, vertices are considered more ‘powerful’ as their alters increase in power. The max power centrality is 14.7905526.

The PageRank algorithm ignores edge weights when calculating the importance of nodes. The more likely an actor will be found when randomly searching through movies, the higher the assigned PageRank.

page_ranks <- projected %>% 
  page_rank()

var_pr <- mean(page_ranks$vector) 

projected <- projected %>% 
  set_vertex_attr(name = "g_page_rank", value = page_ranks$vector)

page_ranks$vector %>% 
  as.data.frame() %>% 
  dplyr::rename(page_r = '.') %>% 
  mutate(page_r = as.numeric(page_r)) %>% 
  ggplot() +
  geom_density(aes(x=page_r)) +
  xlab("Page Rank")

Most nodes have a relatively low page rank. The mean page rank is 0.0001859.

Community Detection

Group Louvain optimises for modularity in the network and therefore tries to create densely connected clusters with sparse connections between the clusters. The densely connected core may not allow for very modular communities to be identified.

node_comms <- as_tbl_graph(projected) %>% 
  activate(nodes) %>% 
  mutate(global_comm = group_louvain(weights = weight)) %>% 
  as.data.frame()

projected <- projected %>% 
  set_vertex_attr("comm", value = node_comms$global_comm)

node_comms <- projected %>%
  as_tbl_graph() %>% 
  as.data.frame()

node_comms %>% 
  ggplot() +
  geom_bar(aes(x=comm))+
  scale_y_log10()+
  NULL

node_comms %>% 
  filter(comm < 55) %>% 
  ggplot() +
  geom_bar(aes(x=comm))+
  geom_vline(xintercept=c(17.5), linetype="dotted")+
  NULL

node_comms_filtered <- node_comms %>% 
  filter(comm <= 53) 

projected <- set_vertex_attr(projected, name = "Label", value = projected$name)

## Warning in length(vattrs[[name]]) <- vc: length of NULL cannot be changed

top_comms_nodes <- node_comms %>% 
  add_count(comm) %>%
  arrange(name, desc(n)) %>% 
  group_by(comm) %>% 
  distinct %>% 
  top_n(5) %>% 
  ungroup() %>% 
  arrange(n) %>% 
  filter(n > 100) %>% 
  arrange(desc(n)) %>% 
  na.omit()
top_comms_nodes

## # A tibble: 3,890 x 7
##    name        g_e_values g_close_cent g_power_cent g_page_rank  comm     n
##    <chr>            <dbl>        <dbl>        <dbl>       <dbl> <int> <int>
##  1 Adam Brown       41.7   0.000000142       1.94     0.0000394     1   535
##  2 Adam Hicks       -2.70  0.000000142      -0.0684   0.000130      1   535
##  3 Adrian Alo…      -1.    0.000000142      -0.328    0.0000640     1   535
##  4 Adrian Les…       3.25  0.000000142       1.65     0.0000517     1   535
##  5 Aida Turtu…      -1.    0.000000142      -1.09     0.000100      1   535
##  6 Aimee Teeg…       1.23  0.000000142      -0.304    0.000153      1   535
##  7 AJ Michalka       6.78  0.000000142       0.0789   0.0000823     1   535
##  8 Al Roker         -1.    0.000000142      -0.475    0.0000559     1   535
##  9 Alan Young        4.94  0.000000142       0.232    0.0000745     1   535
## 10 Alastair D…      -2.25  0.000000142       0.611    0.0000594     1   535
## # … with 3,880 more rows

filtered_actor_edges <- subgraph(projected, top_comms_nodes$name)

g_comm_1_nodes <-  top_comms_nodes %>% 
  filter(comm == 1) 
g_comm_1_graph <- subgraph(projected, g_comm_1_nodes$name) 

e_values_1 <- g_comm_1_graph %>% 
  as_adjacency_matrix(type="both") %>% 
  eigen()


g_comm_1_graph <- g_comm_1_graph %>% 
  set_vertex_attr(name = "local_e_values", value = e_values_1$values)

e_values_1['values'] %>% 
  as.data.frame() %>% 
  ggplot()+
  geom_density(aes(values)) +
  xlab("Eigen value")

close_cent <- g_comm_1_graph %>% 
  closeness()

var <- mean(close_cent)

g_comm_1_graph <- g_comm_1_graph %>% 
  set_vertex_attr(name = "local_close_cent", value = close_cent)

close_cent %>% 
  as.data.frame() %>% 
  dplyr::rename(closeness = '.') %>% 
  ggplot()+
  geom_density(aes(closeness)) +
  xlab("Closeness centrality")

power_cent <- g_comm_1_graph %>% power_centrality(exponent = 0.9)

var <- max(power_cent) 

g_comm_1_graph <- g_comm_1_graph %>% 
  set_vertex_attr(name = "local_power_cent", value = power_cent)

power_cent %>% 
  as.data.frame() %>% 
  dplyr::rename(power = '.') %>% 
  mutate(power = as.numeric(power)) %>% 
  ggplot() +
  geom_density(aes(x=power))

page_ranks <- g_comm_1_graph %>% 
  page_rank()

var <- mean(page_ranks$vector)

g_comm_1_graph <- g_comm_1_graph %>% 
  set_vertex_attr(name = "local_page_rank", value = page_ranks$vector)

page_ranks$vector %>% 
  as.data.frame() %>% 
  dplyr::rename(page_r = '.') %>% 
  mutate(page_r = as.numeric(page_r)) %>% 
  ggplot() +
  geom_density(aes(x=page_r)) +
  xlab("Page Rank")

attributes <- vertex_attr(g_comm_1_graph)

g_comm_1_nodes <-  data.frame(name = attributes['name'], comm = attributes['comm'], g_e_values=attributes['g_e_values'], g_close_cent=attributes['g_close_cent'], g_page_rank = attributes['g_page_rank'], g_power_cent = attributes['g_power_cent'], local_e_values  = attributes['local_e_values'], local_page_rank = attributes['local_page_rank'], local_close_cent = attributes['local_power_cent'], local_close_cent = attributes['local_close_cent'], stringsAsFactors=FALSE)

g_comm_2_nodes <-  top_comms_nodes %>% 
  filter(comm == 2) 
g_comm_2_graph <- subgraph(projected, g_comm_2_nodes$name) 

e_values_2 <- g_comm_2_graph %>% 
  as_adjacency_matrix(type="both") %>% 
  eigen()


g_comm_2_graph <- g_comm_2_graph %>% 
  set_vertex_attr(name = "local_e_values", value = e_values_2$values)

e_values_2['values'] %>% 
  as.data.frame() %>% 
  ggplot()+
  geom_density(aes(values)) +
  xlab("Eigen value")

##Comm Centrality
##Closeness
close_cent <- g_comm_2_graph %>% 
  closeness()

var <- mean(close_cent)

g_comm_2_graph <- g_comm_2_graph %>% 
  set_vertex_attr(name = "local_close_cent", value = close_cent)

close_cent %>% 
  as.data.frame() %>% 
  dplyr::rename(closeness = '.') %>% 
  ggplot()+
  geom_density(aes(closeness)) +
  xlab("Closeness centrality")

power_cent <- g_comm_2_graph %>% power_centrality(exponent = 0.9)

var <- mean(power_cent)

g_comm_2_graph <- g_comm_2_graph %>% 
  set_vertex_attr(name = "local_power_cent", value = power_cent)

power_cent %>% 
  as.data.frame() %>% 
  dplyr::rename(power = '.') %>% 
  mutate(power = as.numeric(power)) %>% 
  ggplot() +
  geom_density(aes(x=power))

##Page Rank
page_ranks <- g_comm_2_graph %>% 
  page_rank()

var <- mean(page_ranks$vector)

g_comm_2_graph <- g_comm_2_graph %>% 
  set_vertex_attr(name = "local_page_rank", value = page_ranks$vector)

page_ranks$vector %>% 
  as.data.frame() %>% 
  dplyr::rename(page_r = '.') %>% 
  mutate(page_r = as.numeric(page_r)) %>% 
  ggplot() +
  geom_density(aes(x=page_r)) +
  xlab("Page Rank")

attributes <- vertex_attr(g_comm_2_graph)

g_comm_2_nodes <-  data.frame(name = attributes['name'], comm = attributes['comm'], g_e_values=attributes['g_e_values'], g_close_cent=attributes['g_close_cent'], g_page_rank = attributes['g_page_rank'], g_power_cent = attributes['g_power_cent'], local_e_values  = attributes['local_e_values'], local_page_rank = attributes['local_page_rank'], local_close_cent = attributes['local_power_cent'], local_close_cent = attributes['local_close_cent'], stringsAsFactors=FALSE)

g_comm_3_nodes <-  top_comms_nodes %>% 
  filter(comm == 3) 
g_comm_3_graph <- subgraph(projected, g_comm_3_nodes$name) 

e_values_3 <- g_comm_3_graph %>% 
  as_adjacency_matrix(type="both") %>% 
  eigen()


g_comm_3_graph <- g_comm_3_graph %>% 
  set_vertex_attr(name = "local_e_values", value = e_values_3$values)

e_values_3['values'] %>% 
  as.data.frame() %>% 
  ggplot()+
  geom_density(aes(values)) +
  xlab("Eigen value")

close_cent <- g_comm_3_graph %>% 
  closeness()

var <- mean(close_cent)

g_comm_3_graph <- g_comm_3_graph %>% 
  set_vertex_attr(name = "local_close_cent", value = close_cent)

close_cent %>% 
  as.data.frame() %>% 
  dplyr::rename(closeness = '.') %>% 
  ggplot()+
  geom_density(aes(closeness)) +
  xlab("Closeness centrality")

power_cent <- g_comm_3_graph %>% power_centrality(exponent = 0.9)

var <- mean(power_cent)

g_comm_3_graph <- g_comm_3_graph %>% 
  set_vertex_attr(name = "local_power_cent", value = power_cent)

power_cent %>% 
  as.data.frame() %>% 
  dplyr::rename(power = '.') %>% 
  mutate(power = as.numeric(power)) %>% 
  ggplot() +
  geom_density(aes(x=power))

page_ranks <- g_comm_3_graph %>% 
  page_rank()

var <- mean(page_ranks$vector)

g_comm_3_graph <- g_comm_3_graph %>% 
  set_vertex_attr(name = "local_page_rank", value = page_ranks$vector)

page_ranks$vector %>% 
  as.data.frame() %>% 
  dplyr::rename(page_r = '.') %>% 
  mutate(page_r = as.numeric(page_r)) %>% 
  ggplot() +
  geom_density(aes(x=page_r)) +
  xlab("Page Rank")

attributes <- vertex_attr(g_comm_3_graph)

g_comm_3_nodes <-  data.frame(name = attributes['name'], comm = attributes['comm'], g_e_values=attributes['g_e_values'], g_close_cent=attributes['g_close_cent'], g_page_rank = attributes['g_page_rank'], g_power_cent = attributes['g_power_cent'], local_e_values  = attributes['local_e_values'], local_page_rank = attributes['local_page_rank'], local_close_cent = attributes['local_power_cent'], local_close_cent = attributes['local_close_cent'], stringsAsFactors=FALSE)

Highlighting nodes using different menasures of importance.

The top nodes from selected communities will be compared to see which measure is the best indicator of higher ratings.

## [1] "Morgan Freeman"

## [1] "Highest global closeness centrality: Morgan Freeman"

## [1] "Highest global Page rank: Morgan Freeman"

## [1] "Highest global Boncich power centrality: Matt Keeslar"

## [1] "Rupert Everett"

## [1] "Highest global closeness centrality: Nathan Lane"

## [1] "Highest local closeness centrality: Jim Belushi"

## [1] "Highest global page rank: Richard Schiff"

## [1] "Highest local page rank: Richard Schiff"

## [1] "Highest global power centrality: Michael McGlone"

## [1] "Highest local power centrality: William Sanderson"

V(g_comm_2_graph)$name[degree(g_comm_2_graph)==max(degree(g_comm_2_graph))]

## [1] "Vanessa Redgrave"

## [1] "Highest global closeness centrality: Robert Duvall"

## [1] "Highest global closeness centrality: Vanessa Redgrave"

## [1] "Highest global Page rank: Robert Duvall"

## [1] "Highest local Page rank: Vanessa Redgrave"

## [1] "Highest global Boncich power centrality: Tabu"

## [1] "Highest local Boncich power centrality: Dan Fogler"

## [1] "Eddie Marsan"

## [1] "Highest global closeness centrality: Steve Coogan"

## [1] "Highest local closeness centrality: Eddie Marsan"

## [1] "Highest global Page rank: Jon Favreau"

## [1] "Highest local Page rank: Eddie Marsan"

## [1] "Highest global Boncich power centrality: Carter Jenkins"

## [1] "Highest local Boncich power centrality: Matthew R. Anderson"

Analysis of centrality measures and ratings

Here the average rating of movies starred in for each actor is calculated.

average_imdb_actor_ratings <- imdb %>% 
  select(imdb_score, actor_1_name) %>% 
  dplyr::rename(actor = actor_1_name) %>% 
  group_by(actor) %>% 
  mutate(avg_rating = mean(imdb_score)) %>% 
  select(-imdb_score) %>% 
  distinct(actor, .keep_all = T) %>% 
  na.omit()

temp2 <- imdb %>% 
  select(imdb_score, actor_2_name) %>% 
  dplyr::rename(actor = actor_2_name) %>% 
  group_by(actor) %>% 
  mutate(avg_rating = mean(imdb_score)) %>% 
  select(-imdb_score) %>% 
  distinct(actor, .keep_all = T) %>% 
  na.omit()

temp3 <- imdb %>% 
  select(imdb_score, actor_3_name) %>% 
  dplyr::rename(actor = actor_3_name) %>% 
  group_by(actor) %>% 
  mutate(avg_rating = mean(imdb_score)) %>% 
  select(-imdb_score) %>% 
  distinct(actor, .keep_all = T) %>% 
  na.omit()

average_imdb_actor_ratings <- full_join(average_imdb_actor_ratings, temp2) %>% 
  group_by(actor) %>% 
  summarise(avg_rating = mean(avg_rating)) 

## Joining, by = c("actor", "avg_rating")

average_imdb_actor_ratings <- full_join(average_imdb_actor_ratings, temp3) %>% 
  group_by(actor) %>% 
  summarise(avg_rating = mean(avg_rating)) 

## Joining, by = c("actor", "avg_rating")

average_imdb_actor_ratings <- average_imdb_actor_ratings[-1,]

average_imdb_actor_ratings %>% 
  filter(actor == 'Morgan Freeman')                    

## # A tibble: 1 x 2
##   actor          avg_rating
##   <chr>               <dbl>
## 1 Morgan Freeman       7.76

average_imdb_actor_ratings %>% 
  filter(actor == 'Matt Keeslar')                    

## # A tibble: 1 x 2
##   actor        avg_rating
##   <chr>             <dbl>
## 1 Matt Keeslar          7

average_imdb_actor_ratings %>% 
  filter(actor == 'Tom Wilkinson')                    

## # A tibble: 1 x 2
##   actor         avg_rating
##   <chr>              <dbl>
## 1 Tom Wilkinson       7.08

average_imdb_actor_ratings %>% 
  filter(actor == 'Miranda Richardson')                    

## # A tibble: 1 x 2
##   actor              avg_rating
##   <chr>                   <dbl>
## 1 Miranda Richardson       6.86

average_imdb_actor_ratings %>% 
  filter(actor == 'R. Marcos Taylor')                    

## # A tibble: 1 x 2
##   actor            avg_rating
##   <chr>                 <dbl>
## 1 R. Marcos Taylor        7.9

average_imdb_actor_ratings %>% 
  filter(actor == 'Eric Sykes')                    

## # A tibble: 1 x 2
##   actor      avg_rating
##   <chr>           <dbl>
## 1 Eric Sykes        7.6

average_imdb_actor_ratings %>% 
  filter(actor == 'Scarlett Johansson')                    

## # A tibble: 1 x 2
##   actor              avg_rating
##   <chr>                   <dbl>
## 1 Scarlett Johansson       7.52

average_imdb_actor_ratings %>% 
  filter(actor == 'Kristin Scott Thomas')                    

## # A tibble: 1 x 2
##   actor                avg_rating
##   <chr>                     <dbl>
## 1 Kristin Scott Thomas       6.94

average_imdb_actor_ratings %>% 
  filter(actor == 'Rachael Harris')                    

## # A tibble: 1 x 2
##   actor          avg_rating
##   <chr>               <dbl>
## 1 Rachael Harris       6.21

average_imdb_actor_ratings %>% 
  filter(actor == 'Steve Coogan')                    

## # A tibble: 1 x 2
##   actor        avg_rating
##   <chr>             <dbl>
## 1 Steve Coogan       6.29

average_imdb_actor_ratings %>% 
  filter(actor == 'Richard Schiff')                    

## # A tibble: 1 x 2
##   actor          avg_rating
##   <chr>               <dbl>
## 1 Richard Schiff       6.14

average_imdb_actor_ratings %>% 
  filter(actor == 'Gary Coleman')                    

## # A tibble: 1 x 2
##   actor        avg_rating
##   <chr>             <dbl>
## 1 Gary Coleman       6.15

average_imdb_actor_ratings %>% 
  filter(actor == 'Pamela Anderson')                    

## # A tibble: 1 x 2
##   actor           avg_rating
##   <chr>                <dbl>
## 1 Pamela Anderson        5.5

average_imdb_actor_ratings %>% 
  filter(actor == 'Morgan Freeman')                    

## # A tibble: 1 x 2
##   actor          avg_rating
##   <chr>               <dbl>
## 1 Morgan Freeman       7.76

average_imdb_actor_ratings %>% 
  filter(actor == 'Tabu')                    

## # A tibble: 1 x 2
##   actor avg_rating
##   <chr>      <dbl>
## 1 Tabu         7.8

average_imdb_actor_ratings %>% 
  filter(actor == 'Charlize Theron')                    

## # A tibble: 1 x 2
##   actor           avg_rating
##   <chr>                <dbl>
## 1 Charlize Theron       6.59

temp1 <- average_imdb_actor_ratings %>% 
  dplyr::rename(name = actor) %>% 
  right_join(g_comm_1_nodes)

## Joining, by = "name"

temp2 <- average_imdb_actor_ratings %>% 
  dplyr::rename(name = actor) %>% 
  right_join(g_comm_2_nodes)

## Joining, by = "name"

temp3 <- average_imdb_actor_ratings %>% 
  dplyr::rename(name = actor) %>% 
  right_join(g_comm_3_nodes)

## Joining, by = "name"

ratings_and_centrality <- do.call("rbind", list(temp1, temp2, temp3))

ratings_and_centrality %>% 
  ggplot() +
  geom_smooth(aes(x = g_e_values, y = avg_rating), method = 'loess') +
  xlab("Global Eigen values") +
  ylab("Avg movie rating") +
  ggtitle("Global Eigen values vs Average Movie rating")

ratings_and_centrality %>% 
  ggplot() +
  geom_smooth(aes(x = g_close_cent, y = avg_rating), method = 'loess') +
  xlab("Global Closeness centrality values") +
  ylab("Avg movie rating") +
  ggtitle("Global Closeness Centrality vs Average Movie rating")

ratings_and_centrality %>% 
  ggplot() +
  geom_smooth(aes(x = g_page_rank, y = avg_rating), method = 'loess') +
  xlab("Global Page Rank values") +
  ylab("Avg movie rating") +
  ggtitle("Global Page Rank vs Average Movie rating")

ratings_and_centrality %>% 
  ggplot() +
  geom_smooth(aes(x = g_power_cent, y = avg_rating), method = 'loess') +
  xlab("Global Power Centrality") +
  ylab("Avg movie rating") +
  ggtitle("Global Boncich Power Centrality vs Average Movie rating")

ratings_and_centrality %>% 
  ggplot() +
  geom_smooth(aes(x = local_e_values, y = avg_rating), method = 'loess') +
  xlab("Eigen vector Centrality") +
  ylab("Avg movie rating") +
  ggtitle("Local Eigen vector Centrality vs Average Movie rating")

ratings_and_centrality %>% 
  ggplot() +
  geom_smooth(aes(x = local_close_cent, y = avg_rating), method = 'loess') +
  xlab("Closeness Centrality") +
  ylab("Avg movie rating") +
  ggtitle("Local Closeness Centrality vs Average Movie rating")

ratings_and_centrality %>% 
  ggplot() +
  geom_smooth(aes(x = local_page_rank, y = avg_rating), method = 'loess') +
  xlab("Page rank") +
  ylab("Avg movie rating") +
  ggtitle("Local Page rank vs Average Movie rating")

ratings_and_centrality %>% 
  ggplot() +
  geom_smooth(aes(x = local_power_cent, y = avg_rating), method = 'loess') +
  xlab("Power Centrality") +
  ylab("Avg movie rating") +
  ggtitle("Local Boncich Power Centrality vs Average Movie rating")

ratings_and_centrality %>% 
  group_by(comm) %>% 
  summarise(avg_rating = mean(avg_rating), avg_e = mean(g_e_values), avg_c_c = mean(g_close_cent), avg_p_r = mean(g_page_rank), avg_p_c = mean(g_power_cent), num = n()) 

## # A tibble: 3 x 7
##    comm avg_rating  avg_e     avg_c_c  avg_p_r avg_p_c   num
##   <int>      <dbl>  <dbl>       <dbl>    <dbl>   <dbl> <int>
## 1     1       6.26 -0.225 0.000000142 0.000122  0.0292   535
## 2     2       6.53  1.01  0.000000142 0.000219 -0.0287   462
## 3     3       6.45  1.69  0.000000142 0.000185 -0.0677   446

Concluding remarks

It can be said that the centrality of nodes is not an indicator of success for movie ratings. The variance in movie ratings is relatively high for very central nodes as well as not as central nodes. There is doubt as to the reliability of the communities due to the densely connected nature of the graph. The